:- module(certification_access, [
        certification_date/3,
        certification_status/3,
        certification_level/3,
        certification_policy/3,
        certification_reference/3,
        certification_artifact_type/3,
        certification_artifact/3,
        certification_verifier/3,
        certification_comments/3,
        certification_check/2,
        certification_update/3,
%% Types
        certification/1,
        certification_field/1
       ], [assertions,basicmodes,regtypes]).

:- comment(title, "Creating and Consulting Certificates").
:- comment(subtitle, "AMOS Project").


:- comment(author, "Manuel Carro and the CLIP group").
:- comment(author, "Facultad de Inform@'{a}tica").
:- comment(author, "Universidad Polit@'{e}cnica de Madrid").
:- comment(author, "@tt{clip@@dia.fi.upm.es}").
:- comment(author, "@tt{http://www.clip.dia.fi.upm.es/}").

:- comment(module, "

Certificates are means to ensure that the properties stated for a given
package hold true, and that the package has not been altered (for
example, by changing code so that misfunction is possible).
Certificates are mandatory (or, at least, highly recommended) in
several application fields (e.g., health care), and can take a range of 
forms, from fingerprints such as MD5 to digital signatures or,
possibly in a future, to proof-carrying code.  Certificates are
associated to assets, in such a way that a given asset may have
different certifications created using different methods or issued by
different (third-part) trusted organizations.


The operations herein included are aimed at creating and consulting
instances of the @em{certification} class.  They may change (for
example, to include more operations) should the ontology evolve in
that direction.


@include{three_argument_explanation.lpdoc}

@sp

@include{../Doc/acknowledgements.lpdoc}

@newpage

").


:- include(db('argnamesv/argnamesv')).   % Kludge to use local version
:- use_module(library(sort)).
:- use_module(db(basic_types)).
:- use_module(db(general_check)).

fields_and_types([
        field(date,          (nonnull, date)),
        field(status,        (nonnull, atom)),
        field(level,         (nonnull, atom)),
        field(policy,        (nonnull, atom)),
        field(reference,     (nonnull, atom)),
        field(artifact_type, (nonnull, atom)),
        field(artifact,      (nonnull, atom)),
        field(verifier,      (nonnull, atom)),
        field(comments,      (null ; atom))
                 ]).


:- argnames is_a_certification(
        date,
        status,
        level,
        policy,
        reference,
        artifact_type,
        artifact,
        verifier,
        comments).


:- regtype certification(?Cert) # "@var{Cert} is a certification.".

certification(is_a_certification${}).


:- regtype certification_field(?Field).

certification_field(Field):-
        member(Field, is_a_certification$argnames).


:- pred certification_date(Cert, Date, NewCert):
        certification * date * certification

# "@var{Date} is the date in which @var{NewCert} was issued.  It
must be present.".

certification_date(Cert, Date, NewCert):-
        certification_update(Cert, [date-Date], NewCert).


:- pred certification_status(Cert, Status, NewCert):
        certification * string * certification

# "@var{Status} is the status of @var{NewCert}.  It must be
present.".

certification_status(Cert, Status, NewCert):-
        certification_update(Cert, [status-Status], NewCert).


:- pred certification_level(Cert, Level, NewCert):
        certification * string * certification

# "@var{Level} is the level of @var{NewCert}.  It must be present.".

certification_level(Cert, Level, NewCert):-
        certification_update(Cert, [level-Level], NewCert).

:- pred certification_policy(Cert, Policy, NewCert):
        certification * string * certification

# "@var{Policy} is the policy of @var{NewCert}.  It must be
present.".

certification_policy(Cert, Policy, NewCert):-
        certification_update(Cert, [policy-Policy], NewCert).


:- pred certification_reference(Cert, References, NewCert):
        certification * string * certification

# "@var{References} are references concerning the certification
@var{NewCert}.  It must be present.".

certification_reference(Cert, References, NewCert):-
        certification_update(Cert, [reference-References], NewCert).


:- pred certification_artifact_type(Cert, Type, NewCert):
        certification * string * certification
# "@var{Type} is the type of @var{NewCert}.  It must be present.".

certification_artifact_type(Cert, Type, NewCert):-
        certification_update(Cert, [artifact_type-Type], NewCert).


:- pred certification_artifact(Cert, Artifact, NewCert):
        certification * string * certification

# "@var{Artifact} is the method used to generate the certification in
of @var{NewCert}.  Commonly used methods are SHA, MD5 or other hash
mark directly extracted from the resource.  It must be present.".

certification_artifact(Cert, Artifact, NewCert):-
        certification_update(Cert, [artifact-Artifact], NewCert).


:- pred certification_verifier(Cert, Verifier, NewCert):
        certification * string * certification

# "@var{Verifier} is a verifier of @var{NewCert}.  It must be
present.".

certification_verifier(Cert, Verifier, NewCert):-
        certification_update(Cert, [verfier-Verifier], NewCert).


:- pred certification_comments(Cert, Comments, NewCert):
        certification * string * certification

# "@var{Comments} are general comments regarding the certification
@var{NewCert}.  It must be present.".

certification_comments(Cert, Comments, NewCert):-
        certification_update(Cert, [comments-Comments], NewCert).


:- pred certification_check(?Cert, ?WrongFields):
        certification * list(certification_fields)

# "The already formed certificate @var{Cert} is checked against the
constraints specified in the ontology definition.
@include{check_definition.lpdoc}".


certification_check(Cert, WrongFields):-
        fields_and_types(F),
        check_each_field(F, Cert, WrongFields).

check_each_field([], _Cert, []).
check_each_field([field(F, T)|Fs], Cert, W):-
        Cert = is_a_certification${F => V},
        (
            check_field(T, V) ->
            W = RestW
        ;
            W = [F|RestW]
        ),
        check_each_field(Fs, Cert, RestW).


:- pred certification_update(+Cert, +PairList, ?NewCert):
        certification * list(pair) * certification

# "It updates @var{Cert} to give @var{NewCert}.  @var{PairList} is a
list of pairs (see @pred{pair}): dash-separated ground terms
@tt{Field-Value}, which are meant to express the name of a field and
its update value.  @pred{certification_update/3} is a general call upon
which all the rest of the @tt{update} calls rely.".


certification_update(Cert, PairList, NewCert):-
        NewCert = is_a_certification${}, % New certification skeleton
        sort(is_a_certification$argnames, AllFields),
        keysort(PairList, SortedPairList),  %% All sorted in same order now
        update(AllFields, SortedPairList, Cert, NewCert).

update([], _, _, _).
update([Field|Fields], [Field-NewValue|ToUpdate], Cert, NewCert):-
        !,
        NewCert = is_a_certification${Field => NewValue},
        update(Fields, ToUpdate, Cert, NewCert).
update([Field|Fields], ToUpdate, Cert, NewCert):-
        Cert = is_a_certification${Field => Value}, 
        NewCert = is_a_certification${Field => Value}, 
        update(Fields, ToUpdate, Cert, NewCert).

:- comment(version_maintenance,on).

:- comment(version(0*1+2,2003/07/04,12:29*49+'CEST'), "Changed
   use_module and include references to use directory aliases.  (Jesus
   Correas Fernandez)").

:- comment(version(0*1+1,2003/02/14,16:25*41+'CET'), "Changed
	CertAfter to NewCert (Manuel Carro)").

:- comment(version(0*1+0,2003/02/13,20:48*55+'CET'), "Initial version,
	with all interfaces included.  (Manuel Carro)").

